home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / fd200.zip / FD_DISP.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-27  |  6KB  |  301 lines
  1. procedure set_x_y;
  2. var i, j : integer;
  3. begin
  4.   for i := 0 to 4 do
  5.     for j := 0 to 14 do
  6.       x_y[i,j] := 649 + 30*i + 160*j;
  7. end;
  8.  
  9. procedure clear_attr;
  10. var i : integer;
  11.     attr : integer;
  12. begin
  13.   attr := norm_b SHL 4 + norm_f;
  14.   video_disable;
  15.   for i := 0 to 13 do
  16.     video[x_y[x,y] + i SHL 1] := attr;
  17.   video_enable;
  18. end;
  19.  
  20. procedure show_attr;
  21. var i : integer;
  22.     attr : integer;
  23. begin
  24.   attr := brite_b SHL 4 + brite_f;
  25.   video_disable;
  26.   for i := 0 to 13 do
  27.     video[x_y[x,y] + i shl 1] := attr;
  28.   video_enable;
  29. end;
  30.  
  31. procedure go_up;
  32. begin
  33.   clear_attr;
  34.   y := y - 1;
  35.   if ( y < 0) then
  36.     begin y := 14;
  37.           x := x - 1;
  38.           if x < 0 then x := 4;
  39.     end;
  40. end;
  41.  
  42.  
  43. procedure go_dwn;
  44. begin
  45.   clear_attr;
  46.   y := y + 1;
  47.   if y = 15 then
  48.     begin y := 0;
  49.           x := x + 1;
  50.           if x = 5 then x := 0;
  51.     end;
  52. end;
  53.  
  54. procedure go_left;
  55. begin
  56.   clear_attr;
  57.   x := x - 1;
  58.   if x < 0 then
  59.     begin x := 4;
  60.           y := y - 1;
  61.           if y < 0 then y := 14;
  62.     end;
  63. end;
  64.  
  65. procedure go_right;
  66. begin
  67.   clear_attr;
  68.   x := x + 1;
  69.   if x = 5 then
  70.     begin x := 0;
  71.           y := y + 1;
  72.           if y = 15 then y := 0;
  73.     end;
  74. end;
  75.  
  76. procedure clear_section;
  77. begin
  78.   normcolor;
  79.   gotoxy(25,11);
  80.   write('               ');
  81. end;
  82.  
  83. procedure disp_section(s : section_type);
  84. begin
  85.   clear_section;
  86.   gotoxy(25,11);
  87.   write(s:15);
  88.   hide_cursor;
  89. end;
  90.  
  91. function section: section_type;
  92. var skey: char;
  93.     i : integer;
  94.     country : section_type;
  95. begin
  96.   if auto_section = TRUE
  97.   then begin
  98.     save_screen;
  99.     video_disable;
  100.     move(image2,video,4000);
  101.     video_enable;
  102.     hide_cursor;
  103.     repeat
  104.       show_attr;
  105.       skey := readkey;
  106.       case skey of
  107.         #72 : go_up;
  108.         #80 : go_dwn;
  109.         #75 : go_left;
  110.         #77 : go_right;
  111.       end;
  112.     until skey = #13;
  113.     if sections[y,x] = 'OTHER' then
  114.     begin
  115.       gotoxy(10,23);
  116.       write('Enter Country : xxxxxxxxxxxxxxx');
  117.       for i := 0 to 14 do write(#8);
  118.       readln(country);
  119.     end
  120.     else country := sections[y,x];
  121.     UpperCase(country);
  122.     section := country;
  123.     restore_screen;
  124.   end
  125.   else begin
  126.     clear_section;
  127.     gotoxy(25,11);
  128.     readln(country);
  129.     UpperCase(country);
  130.     section := country;
  131.   end;
  132. end;
  133.  
  134. procedure found_it;
  135. var note,
  136.     i,
  137.     attr : integer;
  138. begin
  139.   attr := brite_b SHL 4 + brite_f;
  140.   video_disable;
  141.   for i := 0 to 5 do
  142.     video[1613 + i shl 1] := attr;
  143.   video_enable;
  144.   gotoxy(32,4); brite_color;
  145.   write('D U P L I C A T E');
  146.   hide_cursor;
  147.   normcolor;
  148.   for note := 1 to 3 do
  149.   begin
  150.     if tunes = TRUE then sound(660); delay(100);
  151.     if tunes = TRUE then sound(440); delay(100);
  152.   end;
  153.   nosound;
  154.   attr := norm_b SHL 4 + norm_f;
  155.   video_disable;
  156.   for i := 0 to 5 do
  157.     video[1613 + i SHL 1] := attr;
  158.   video_enable;
  159.   gotoxy(32,4); ClrEol;
  160.   hide_cursor;
  161. end;
  162.  
  163. procedure clear_callsign;
  164. begin
  165.   normcolor;
  166.   gotoxy(7,11);
  167.   write('      ');
  168.   tbranch^.leaf.callsign := '';
  169. end;
  170.  
  171. procedure disp_callsign(c : callsign_type);
  172. begin
  173.   clear_callsign;
  174.   gotoxy(7,11);
  175.   write(c : 6);
  176.   hide_cursor;
  177. end;
  178.  
  179. function enter_callsign: callsign_type;
  180. var callsign : callsign_type;
  181. begin
  182.   callsign := '';
  183.   clear_callsign;
  184.   gotoxy(7,11);
  185.   readln(callsign);
  186.   UpperCase(callsign);
  187.   while length(callsign) < 6 do callsign := ' ' + callsign;
  188.   disp_callsign(callsign);
  189.   enter_callsign := callsign;
  190. end;
  191.  
  192. procedure clear_class;
  193. begin
  194.   normcolor;
  195.   gotoxy(18,11);
  196.   write('   ');
  197.   tbranch^.leaf.class := ' ';
  198. end;
  199.  
  200. procedure disp_class( c : class_type);
  201. begin
  202.   clear_class;
  203.   gotoxy(18,11);
  204.   write(c : 3);
  205.   hide_cursor;
  206. end;
  207.  
  208. function enter_class: class_type;
  209. var d_class : class_type;
  210. begin
  211.   d_class := '';
  212.   clear_class;
  213.   gotoxy(18,11);
  214.   readln(d_class);
  215.   UpperCase(d_class);
  216.   disp_class(d_class);
  217.   enter_class := d_class;
  218. end;
  219.  
  220. procedure disp_mode;
  221. begin
  222.   normcolor;
  223.   gotoxy(43,11);
  224.   case op_mode of
  225.     CW :     write('  CW  ');
  226.     AM :     write('  AM  ');
  227.     FM :     write('  FM  ');
  228.     SSB :    write('  SSB ');
  229.     RTTY :   write(' RTTY ');
  230.     AMTOR :  write('AMTOR ');
  231.     PACKET : write('PACKET');
  232.   end;
  233.   hide_cursor;
  234. end;
  235.  
  236. procedure change_mode;
  237. begin
  238.   normcolor;
  239.   op_mode := succ(op_mode);
  240.   if op_mode = M_END then op_mode := CW;
  241.   disp_mode;
  242. end;
  243.  
  244. procedure disp_band;
  245. begin
  246.   gotoxy(51,11);
  247.   case band of
  248.     B160 : write('160');
  249.     B80  : write(' 80');
  250.     B40  : write(' 40');
  251.     B20  : write(' 20');
  252.     B15  : write(' 15');
  253.     B10  : write(' 10');
  254.     B6   : write('  6');
  255.     B2   : write('  2');
  256.     B220 : write('220');
  257.     B440 : write('440');
  258.   end;
  259.   hide_cursor;
  260. end;
  261.  
  262. procedure change_band;
  263. begin
  264.   band := succ(band);
  265.   if band = B_END then band := B160;
  266.   disp_band;
  267. end;
  268.  
  269. procedure clear_all;
  270. begin
  271.   clear_callsign;
  272.   clear_class;
  273.   clear_section;
  274.   tbranch^.leaf.section := ' ';
  275.   hide_cursor;
  276. end;
  277.  
  278. procedure date_time;
  279. begin
  280.   if tbranch^.leaf.time <> time then
  281.   begin
  282.     normcolor;
  283.     gotoxy(59,11);
  284.     write(date);
  285.     tbranch^.leaf.date := date;
  286.     gotoxy(70,11);
  287.     write(time);
  288.     tbranch^.leaf.time := time;
  289.     hide_cursor;
  290.   end;
  291. end;
  292.  
  293. procedure disp_score;
  294. begin
  295.   normcolor;
  296.   gotoxy(33,14); write(contacts[ord(band)]:4);
  297.   gotoxy(48,14); write(total_contacts:4);
  298.   gotoxy(63,14); write(score:5);
  299.   hide_cursor;
  300. end;
  301.